SuperHack/SuperHack CD.bin/CODING/VBASIC/VBLISTER.ZIP/VBLISTER.FRM

Visual Basic Form | 1996-02-23 | 13.2 KB | 416 lines

VERSION 4.00
Begin VB.Form frmList
   BackColor       =   &H00C0FFFF&
   Caption         =   "VB File Lister"
   ClientHeight    =   6270
   ClientLeft      =   2250
   ClientTop       =   3390
   ClientWidth     =   9690
   Height          =   6675
   Left            =   2190
   LinkTopic       =   "Form1"
   ScaleHeight     =   6270
   ScaleWidth      =   9690
   Top             =   3045
   Width           =   9810
   Begin VB.DriveListBox Drive1
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   315
      Left            =   240
      TabIndex        =   5
      Top             =   240
      Width           =   4215
   End
   Begin VB.DirListBox Dir1
      Appearance      =   0  'Flat
      Height          =   4755
      Left            =   240
      TabIndex        =   4
      Top             =   840
      Width           =   4095
   End
   Begin VB.FileListBox File1
      Appearance      =   0  'Flat
      Height          =   4710
      Left            =   4440
      TabIndex        =   3
      Top             =   840
      Width           =   5070
   End
   Begin VB.CommandButton Command1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Exit"
      Height          =   390
      Left            =   3960
      TabIndex        =   2
      Top             =   5760
      Width           =   1095
   End
   Begin VB.TextBox VBP
      Height          =   300
      Left            =   5640
      TabIndex        =   1
      Text            =   " "
      Top             =   240
      Width           =   1356
   End
   Begin VB.CheckBox Check1
      BackColor       =   &H00C0FFFF&
      Caption         =   "Indent On"
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   7320
      TabIndex        =   0
      Top             =   240
      Width           =   1365
   End
   Begin VB.Label Label2
      BackStyle       =   0  'Transparent
      Caption         =   "VBP File"
      Height          =   285
      Left            =   4680
      TabIndex        =   6
      Top             =   240
      Width           =   855
   End
Attribute VB_Name = "frmList"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Public FileNm As Variant
Public FilePath As String
Public IndentIt As String
Private Sub IndentOn_Click()
If IndentOn = True Then
    IndentIt = "YES"
    IndentIt = "NO"
End If
End Sub
Private Sub Command1_Click()
Unload frmList
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
If Right(File1.Path, 1) <> "\" Then
   FileNm = File1.Path & "\" & File1.filename
 Else
   FileNm = File1.Path & File1.filename
End If
MousePointer = 11
FilePath = File1.Path & "\"
Call ListSource(FileNm, FilePath, vbp)
MousePointer = 0
End Sub
Private Sub Form_Load()
Left = (Screen.Width - Width) / 2   ' Center form horizontally.
Top = (Screen.Height - Height) / 2  ' Center form vertically.
End Sub
Public Sub ListSource(FileNm, FilePath, vbp)
Dim L As Variant
Dim LinesPerPage As Integer
Dim CaseCount As Integer
Dim VBPF As String
On Error Resume Next
Printer.Orientation = 2
ChangeFont "MS LineDraw", 8
If Trim(vbp.Text) <> "" Then
    A$ = "* * * P R O J E C T  F I L E * * *"
    Printer.Print
    Printer.Print String$(132, "-")
    Printer.Print Tab((132 - Len(A$)) / 2); A$
    Printer.Print String$(132, "-")
    VBPF = Trim(FilePath) & Trim(vbp) & ".vbp"
    Open VBPF For Input As #1
    Do Until EOF(1)
       Line Input #1, L
       Printer.Print Tab(1); L
    Loop
    Close #1
    Printer.NewPage
    Printer.Orientation = 2
    ChangeFont "MS LineDraw", 10
End If
Open FileNm For Input As #1
LinesPerPage = 0
CaseCount = 0
Indent = 1
ChangeFont "MS LineDraw", 8
Printer.Print String$(132, "-")
A$ = "File: " & FileNm
ChangeFont "MS LineDraw", 12
Printer.Print UCase$(A$)
ChangeFont "MS LineDraw", 8
Printer.Print String$(132, "-")
ChangeFont "MS LineDraw", 12
Printer.Print "Subroutines And Functions In This Program :"
ChangeFont "MS LineDraw", 8
Do Until EOF(1)
   Line Input #1, L
   L = Trim(L)
   If UCase$(Left(L, 3)) = "SUB" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 11)) = "PRIVATE SUB" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 10)) = "PUBLIC SUB" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 10)) = "STATIC SUB" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 16)) = "PRIVATE FUNCTION" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 15)) = "PUBLIC FUNCTION" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 15)) = "STATIC FUNCTION" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 8)) = "FUNCTION" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 16)) = "PRIVATE PROPERTY" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 15)) = "PUBLIC PROPERTY" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 15)) = "STATIC PROPERTY" Then Printer.Print Tab(5); Trim(L)
   If UCase$(Left(L, 8)) = "PROPERTY" Then Printer.Print Tab(5); Trim(L)
Printer.NewPage
Printer.Orientation = 2
ChangeFont "MS LineDraw", 8
A$ = "* * * I N I T I A L I Z A T I O N * * *"
Printer.Print
Printer.Print String$(132, "-")
Printer.Print Tab((132 - Len(A$)) / 2); A$
Printer.Print String$(132, "-")
Close #1
Open FileNm For Input As #1
Do Until EOF(1)
   NewP = False
   If LinesPerPage > 62 Then
      Printer.NewPage
      Printer.Orientation = 2
      ChangeFont "MS LineDraw", 8
      LinesPerPage = 0
      NewP = True
   End If
   Line Input #1, L
   If IndentIt = "YES" Then L = Trim(L)
   'Pad to 227 and create multi lines in case L is > 132.  Allows upto 227 chars per line
   If IndentIt = "YES" Then L = Trim(L) & Space(227 - Len(L))
   If UCase$(Left(L, 3)) = "SUB" Or UCase$(Left(L, 11)) = "PRIVATE SUB" Or UCase$(Left(L, 10)) = "PUBLIC SUB" Or UCase$(Left(L, 10)) = "STATIC SUB" Then
      If Not NewP Then
          Printer.NewPage
          Printer.Orientation = 2
          ChangeFont "MS LineDraw", 8
          Indent = 1
          LinesPerPage = 0
      End If
      A$ = "* * * N E W  S U B R O U T I N E * * *"
      Printer.Print
      Printer.Print String$(132, "-")
      Printer.Print Tab((132 - Len(A$)) / 2); A$
      Printer.Print String$(132, "-")
      ChangeFont "MS LineDraw", 12
      Printer.Print L
      ChangeFont "MS LineDraw", 8
      LinesPerPage = LinesPerPage + 4
   ElseIf UCase$(Left(L, 8)) = "FUNCTION" Or UCase$(Left(L, 16)) = "PRIVATE FUNCTION" Or UCase$(Left(L, 15)) = "PUBLIC FUNCTION" Or UCase$(Left(L, 15)) = "STATIC FUNCTION" Then
      If Not NewP Then
        Printer.NewPage
        Printer.Orientation = 2
        ChangeFont "MS LineDraw", 8
        Printer.Orientation = 2
        LinesPerPage = 0
        Indent = 1
      End If
      A$ = "* * * N E W  F U N C T I O N * * *"
      Printer.Print String$(132, "-")
      Printer.Print Tab((132 - Len(A$)) / 2); A$
      Printer.Print String$(132, "-")
      ChangeFont "MS LineDraw", 12
      Printer.Print L
      ChangeFont "MS LineDraw", 8
      LinesPerPage = LinesPerPage + 4
   ElseIf UCase$(Left(L, 8)) = "PROPERTY" Or UCase$(Left(L, 16)) = "PRIVATE PROPERTY" Or UCase$(Left(L, 15)) = "PUBLIC PROPERTY" Or UCase$(Left(L, 15)) = "STATIC PROPERTY" Then
      If Not NewP Then
        Printer.NewPage
        Printer.Orientation = 2
        ChangeFont "MS LineDraw", 8
        LinesPerPage = 0
        Indent = 1
      End If
      A$ = "* * * N E W  P R O P E R T Y * * *"
      Printer.Print String$(132, "-")
      Printer.Print Tab((132 - Len(A$)) / 2); A$
      Printer.Print String$(132, "-")
      ChangeFont "MS LineDraw", 12

      Printer.Print L
      ChangeFont "MS LineDraw", 8

      LinesPerPage = LinesPerPage + 4
   ElseIf UCase$(Left(L, 7)) = "END SUB" Then
     ChangeFont "MS LineDraw", 12
      Printer.Print L
      LinesPerPage = LinesPerPage + 2
      ChangeFont "MS LineDraw", 8
   ElseIf UCase$(Left(L, 12)) = "END FUNCTION" Then
     ChangeFont "MS LineDraw", 12
      Printer.Print L
      LinesPerPage = LinesPerPage + 2
      ChangeFont "MS LineDraw", 8
   ElseIf UCase$(Left(L, 12)) = "END PROPERTY" Then
      ChangeFont "MS LineDraw", 12
      Printer.Print L
      LinesPerPage = LinesPerPage + 2
      ChangeFont "MS LineDraw", 8
   ElseIf UCase$(Left(L, 1)) = "'" Then
      Printer.Print
      Printer.Print L
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 3)) = "IF " And InStr(1, UCase$(L), "THEN") <> 0 Then
      Printer.Print
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Indent = Indent + 5
      LinesPerPage = LinesPerPage + 1
   ElseIf UCase$(Left(L, 6)) = "END IF" Then
      Indent = Indent - 5
      If Indent < 1 Then Indent = 1
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      LinesPerPage = LinesPerPage + 1
   ElseIf UCase$(Left(L, 4)) = "ELSE" Then
      Indent = Indent - 2
      If Indent < 1 Then Indent = 1
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Indent = Indent + 2
      LinesPerPage = LinesPerPage + 1
   ElseIf InStr(1, L, UCase$("ELSEIF")) <> 0 Then
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Indent = Indent + 5
      LinesPerPage = LinesPerPage + 1
   ElseIf UCase$(Left(L, 3)) = "DO " Then
      Printer.Print
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Indent = Indent + 3
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 5)) = "LOOP " Then
      Indent = Indent - 3
      If Indent < 1 Then Indent = 1
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Printer.Print
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 4)) = "FOR " Then
      Printer.Print
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Indent = Indent + 5
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 5)) = "NEXT " Then
      Indent = Indent - 5
      If Indent < 1 Then Indent = 1
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Printer.Print
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 11)) = "SELECT CASE" Then
      Printer.Print
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If

      Indent = Indent + 5
      CaseCount = 0
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 5)) = "CASE " Then
         Indent = Indent - 3
         If Indent < 1 Then Indent = 1
         Printer.Print
          If IndentIt = "YES" Then
            Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
          Else
            Printer.Print Tab(1); L
          End If

         Indent = Indent + 3
         LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 10)) = "END SELECT" Then
      Indent = Indent - 5
      If Indent < 1 Then Indent = 1
      Printer.Print
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If
      CaseCount = 0
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 5)) = "TYPE " Then
      Printer.Print
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If
      Indent = Indent + 4
      LinesPerPage = LinesPerPage + 2
   ElseIf UCase$(Left(L, 8)) = "END TYPE" Then
      Indent = Indent - 4
      If Indent < 1 Then Indent = 1
      If IndentIt = "YES" Then
        Printer.Print Tab(Indent); Left$(L, Len(L) - Indent)
      Else
        Printer.Print Tab(1); L
      End If
      Printer.Print
      LinesPerPage = LinesPerPage + 2
    Else
      If IndentIt = "YES" Then
         Printer.Print Tab(Indent); Left$(Trim(L), 160 - Indent)
      Else
         Printer.Print Tab(1); L
      End If
      LinesPerPage = LinesPerPage + 1
    End If
Printer.EndDoc
Close #1
End Sub
Sub ChangeFont(Fname As String, Fsize As Integer)
Dim x As New StdFont
x.Name = Fname
x.Size = Fsize
Printer.Print ""
Set Printer.Font = x
End Sub